home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr48 / tttsrc51.zip / PULLTTT5.PAS < prev    next >
Pascal/Delphi Source File  |  1993-01-04  |  24KB  |  759 lines
  1. {--------------------------------------------------------------------------}
  2. {                         TechnoJock's Turbo Toolkit                       }
  3. {                                                                          }
  4. {                              Version   5.10                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {               Copyright 1986-1993 TechnoJock Software, Inc.              }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.           {--------------------------------}
  13.           {       Unit:  PullTTT5          }
  14.           {--------------------------------}
  15.  
  16.  
  17. {$S-,R-,V-}
  18. {$IFNDEF DEBUG}
  19. {$D-}
  20. {$ENDIF}
  21. {Change History:    4/01/89   5.01   Added DOS errorlevel of 12 on fatal
  22.                 error - line 186
  23.               5.01   Changed type def of Sub_Menu to
  24.                 Max_Pull_Width - line 144
  25.               5.01   Changed error message 6  - line 180
  26.               5.01a  Removed references to VER50 and added
  27.                 DEBUG compiler directive
  28.                5.01b removed a '+' from string expression to enable compile
  29.                      with Quick Pascal (!)
  30.                5.02a  9/4/90         Force the Sub-pick to zero when no
  31.                                      sub-menu.
  32.                5.02b 12/13/90        Problems with 80 character menus
  33.                5.10  01/04/93        DPMI compatible version
  34. }
  35. unit PullTTT5;
  36.  
  37. Interface
  38.  
  39. Uses CRT, DOS, FastTTT5, WinTTT5, KeyTTT5;
  40.  
  41. Const
  42.     Max_Pull_Topics = 60;
  43.     Max_Pull_Width  = 30;
  44. type
  45.     Pull_Array = array [1..Max_Pull_Topics] of string[Max_Pull_Width];
  46.     {$IFNDEF VER40}
  47.      Pull_Hook = Procedure(var Ch: char; Main, Sub :byte);
  48.     {$ENDIF}
  49.     MenuDisplay = record
  50.           TopX:byte;
  51.           TopY:byte;
  52.           Style:byte;
  53.           FCol: byte;       {normal option foreground color}
  54.           BCol: byte;       {normal option background color}
  55.           CCol: byte;       {color of first Character}
  56.           MBCol: byte;      {highlight bgnd col for main pick when sub-menu displayed}
  57.           HFCol: byte;      {highlighted option foreground}
  58.           HBCol: byte;      {highlighted option background}
  59.           BorCol: byte;     {border foreground color}
  60.           Gap   : byte;     {Gap between Picks}
  61.           LeftChar    : char;     {left-hand topic highlight character}
  62.           RightChar   : char;     {right-hand topic highlight character}
  63.           AllowEsc    : boolean; {is Escape key operative}
  64.           RemoveMenu  : boolean;{clear screen on exit}
  65.           AlwaysDown : boolean;
  66.           {$IFNDEF VER40}
  67.           Hook         : Pull_hook;
  68.           {$ENDIF}
  69.        end;
  70. Const
  71.     Max_MainPicks = 8;
  72.     Max_Subpicks  = 10;
  73.     MainInd = '\';           {symbol that indicates main menu description}
  74.  
  75. Var
  76.   PTTT : MenuDisplay;
  77.  
  78.   {$IFDEF VER40}
  79.   PM_UserHook : pointer;
  80.   {$ENDIF}
  81.  
  82. {$IFNDEF VER40}
  83. Procedure No_Hook(var Ch: char; Main, Sub :byte);
  84. {$ENDIF}
  85.  
  86. Procedure Pull_Menu( Definition:Pull_Array; var PickM, PickS:byte);
  87.  
  88.  
  89. Implementation
  90.  
  91.   {$IFNDEF VER40}
  92.   {$F+}
  93.   Procedure No_Hook(var Ch: char; Main, Sub :byte);
  94.   {}
  95.   begin
  96.   end; {of proc No_Hook}
  97.   {$F-}
  98.   {$ENDIF}
  99.  
  100.    {$IFDEF VER40}
  101.    Procedure CallFromPM(var Ch: char; Main, Sub :byte);
  102.     Inline($FF/$1E/PM_UserHook);
  103.    {$ENDIF}
  104.  
  105.    Procedure Default_Settings;
  106.    begin
  107.        {$IFDEF VER40}
  108.        PM_UserHook := nil;
  109.        {$ENDIF}
  110.        With PTTT do
  111.        begin
  112.      {$IFNDEF VER40}
  113.      Hook := No_Hook;
  114.      {$ENDIF}
  115.      TopY := 1;
  116.      TopX := 1;
  117.      Style := 1;
  118.      Gap := 2;
  119.      LeftChar := #016;
  120.      RightChar := #017;
  121.      AllowEsc := true;
  122.      RemoveMenu := true;
  123.      AlwaysDown := true;
  124.      If not ColorScreen then {monochrome}
  125.      begin
  126.          FCol  := lightgray;
  127.          BCol  := black;
  128.          CCol  := white;
  129.          MBCol  := lightgray;
  130.          HFCol  := black;
  131.          HBCol  := lightgray;
  132.          BorCol := lightgray;
  133.      end
  134.      else                    {color}
  135.      begin
  136.          FCol  := yellow;
  137.          BCol  := blue;
  138.          CCol  := lightcyan;
  139.          MBCol  := red;
  140.          HFCol  := yellow;
  141.          HBCol  := red;
  142.          BorCol := cyan;
  143.      end;
  144.       end;
  145.   end; {Proc Default_Settings}
  146.  
  147.  
  148. Procedure Pull_Menu(Definition: Pull_Array; var PickM, PickS:byte);
  149. const
  150.     CursUp = #200  ;  CursDown = #208  ;  CursLeft = #203  ;   CursRight = #205;
  151.     HomeKey = #199 ;  Endkey   = #207  ;  Esc      = #027  ;   Enter     = #13;
  152.     F1      = #187 ;
  153.  
  154. type
  155.    Sub_details = record
  156.          Text:  Array[0..Max_SubPicks] of string[Max_Pull_Width];     {5.01}
  157.          Total: byte;
  158.          Width: byte;
  159.          LastPick: byte;
  160.       end;
  161. var
  162.   Submenu  : array [1..Max_MainPicks] of Sub_Details;
  163.   Tot_main : byte;              {total number of main picks}
  164.   Main_Wid : byte;              {width of main menu box}
  165.   Finished,                     {has user selected menu option}
  166.   Down     : boolean;           {indicates if sub-menu displayed}
  167.   ChM,ChT      : char;          {keypressed character}
  168.   X1, Y1, X2, Y2 : byte;        {lower menu borders}
  169.   Cap,Count      : byte;        {used to check if letter pressed = first char}
  170.   Saved_Screen : Pointer;
  171.   I                 : integer;
  172.   TLchar,           {border submenu upper left char}
  173.   TRchar,           {border submenu upper right char}
  174.   BLchar,           {border submenu bottom left char}
  175.   BRchar,           {border submenu bottom right char}
  176.   Joinchar,         {border joining character}
  177.   Joindownchar,     {border joining character}
  178.   JoinleftChar,     {border joining character}
  179.   VertChar,         {border vert character}
  180.   Horizchar:char;   {border horiz char}
  181.  
  182.  
  183.     Procedure PullError(No : byte);
  184.     var M : string;
  185.     begin
  186.   Case No of
  187.   1 : M := 'Menu definiton must start with a Main ("\") description';
  188.   2 : M := 'Main menu definition must be at least 1 character';
  189.   3 : M := 'Too many main menu picks.';
  190.   4 : M := 'Too many sub-menu picks.';
  191.   5 : M := 'No end of menu indicator found';
  192.   6 : M := 'Must be at least two main menu picks';   {5.01}
  193.   7 : M := 'Main menu will not fit in 80 characters';
  194.   8 : M := 'No memory to save screen';
  195.   end; {case}
  196.   Writeln;
  197.   Writeln(M);
  198.   Halt(12);           {5.01}
  199.     end; {Abort}
  200.  
  201.     Procedure Set_Style;
  202.     {Sets variables for the box characters based on defined style}
  203.     begin
  204.   Case PTTT.Style of
  205.   1  :  begin
  206.        TLchar := #218;
  207.        TRchar := #191;
  208.        BLchar := #192;
  209.        BRchar := #217;
  210.        Joinchar := #194;
  211.        Joindownchar := #193;
  212.        JoinleftChar := #180;
  213.        VertChar := #179;
  214.        Horizchar := #196;
  215.         end;
  216.   2  :  begin
  217.        TLchar := #201;
  218.        TRchar := #187;
  219.        BLchar := #200;
  220.        BRchar := #188;
  221.        Joinchar := #203;
  222.        Joindownchar := #202;
  223.        JoinleftChar := #185;
  224.        VertChar := #186;
  225.        Horizchar := #205;
  226.         end;
  227.   else
  228.        begin
  229.        TLchar := ' ';
  230.        TRchar := ' ';
  231.        BLchar := ' ';
  232.        BRchar := ' ';
  233.        Joinchar := ' ';
  234.        Joindownchar := ' ';
  235.        JoinleftChar := ' ';
  236.        VertChar := ' ';
  237.        Horizchar := ' ';
  238.         end;
  239.   end; {Case}
  240.     end;  {Proc Set_Style}
  241.  
  242.     Procedure Save_Screen;
  243.     {saved part of screen overlayed by menu}
  244.     begin
  245.   If MaxAvail < DisplayLines*160 then
  246.      PullError(8)
  247.   else
  248.   begin
  249.       GetMem(Saved_Screen,DisplayLines*160);
  250.       PartSave(1,1,80,DisplayLines,Saved_Screen^);
  251.   end;
  252.     end; {of proc Save_Screen}
  253.  
  254.     Procedure PartRestoreScreen(X1,Y1,X2,Y2:byte);
  255.     {Move from heap to screen, part of saved screen}
  256.     Var
  257.        I,width     : byte;
  258.        ScreenAdr   : integer;
  259.     begin
  260.   Width := succ(X2- X1);
  261.   For I :=  Y1 to Y2 do
  262.   begin
  263.       ScreenAdr   := Pred(I)*160 + Pred(X1)*2;
  264.       MoveToScreen(Mem[Seg(Saved_Screen^):ofs(Saved_Screen^)+SCreenAdr],
  265.          Mem[seg(BaseOfScreen^):ofs(BaseOfScreen^)+ScreenAdr],
  266.          width);
  267.   end;
  268.     end;
  269.  
  270.       Procedure Restore_Screen;
  271.       {saved part of screen overlayed by menu}
  272.       begin
  273.     PartRestore(1,1,80,DisplayLines,Saved_Screen^);
  274.       end;
  275.  
  276.       Procedure Dispose_Screen;
  277.       {}
  278.       begin
  279.     FreeMem(Saved_Screen,DisplayLines*160);
  280.       end;
  281.  
  282.     Procedure Load_Menu_Parameters;
  283.     { converts the MenuDesc array into the Sub_menu array, and
  284.       determines Tot_main
  285.     }
  286.     var
  287.       I, Maj, Min, Widest : integer;
  288.       Instr : string[30];
  289.       Finished : Boolean;
  290.     begin
  291.   FillChar(Submenu,sizeof(Submenu),#0);
  292.   Tot_main := 0;
  293.   If Definition[1][1] <> '\' then PullError(1);
  294.   Maj := 0;
  295.   Widest := 0;
  296.   I := 0;
  297.   Finished := false;
  298.   While (I < Max_Pull_Topics) and (Finished=false) do
  299.   begin
  300.       Inc(I);
  301.       If Definition[I] <> '' then
  302.       begin
  303.      Instr := Definition[I];
  304.      If Instr[1] = MainInd then
  305.      begin
  306.          If Maj <> 0 then           {update values for last sub menu}
  307.          begin
  308.         SubMenu[Maj].Total := Min;
  309.         SubMenu[Maj].Width := widest;
  310.          end;
  311.          If length(Instr) < 2 then PullError(2);
  312.          If Instr = Mainind + mainind then   {must have loaded all data}
  313.          begin                               {note number of main menu }
  314.         Tot_main := Maj;                   {picks and exit}
  315.         Finished := true;
  316.          end;
  317.          Maj := succ(Maj);
  318.          If Maj > Max_mainpicks then PullError(3);
  319.          delete(Instr,1,1);
  320.          SubMenu[Maj].text[0] := Instr;
  321.          Min := 0;                      {reset values for next sub heading}
  322.          Widest := 0;
  323.      end
  324.      else         {not a main menu heading}
  325.      begin
  326.          Min := succ(Min);
  327.          If Min > Max_SubPicks then PullError(4);
  328.          SubMenu[Maj].text[Min] := Instr;
  329.          If length(Instr) > widest then
  330.             widest := length(Instr);
  331.      end;   {if main heading}
  332.       end;
  333.   end; {while}
  334.   If Tot_main = 0 then PullError(5);
  335.   If Tot_main < 2 then PullError(6);
  336.    end; {sub-proc Load_Menu_Parameters}
  337.  
  338.    Function First_Capital(InStr:string; Var StrPos:byte):char;
  339.    {returns the first capital letter in a string and Character position}
  340.    begin
  341.        StrPos := 1;
  342.        While (StrPos <= length(InStr))  and ((InStr[StrPos] in [#65..#90]) = false) do
  343.         StrPos := Succ(StrPos);
  344.        If StrPos > length(InStr) then
  345.        begin
  346.      StrPos := 0;
  347.      First_Capital := ' ';
  348.        end
  349.        else
  350.     First_Capital := InStr[StrPos];
  351.    end;   {First_Capital}
  352.  
  353.    Procedure Display_Main_Picks(No : byte; Col : byte);
  354.    { displays main heading for menu pick 'No', if Col = 1 then
  355.      PTTT.HFCol and PTTT.MBCol cols are used without arrows, else PTTT.FCol and PTTT.BCol
  356.      colors are used}
  357.    var
  358.      ChT : Char;
  359.      X, I, B : byte;
  360.    begin
  361.        X := 1;
  362.        If No = 1 then
  363.     X := X + PTTT.TopX + PTTT.Gap
  364.        else
  365.        begin
  366.      For I := 1 to No - 1 do
  367.          X := X + length(Submenu[I].Text[0]) + PTTT.Gap;
  368.      X := X + PTTT.TopX  + PTTT.Gap ;
  369.        end;
  370.        If Col > 0 then
  371.     Fastwrite(X,PTTT.TopY+ord(PTTT.Style>0),attr(PTTT.HFCol,PTTT.MBCol),
  372.          Submenu[No].Text[0])
  373.        else
  374.        begin
  375.      Fastwrite(X,PTTT.TopY+ord(PTTT.Style>0),attr(PTTT.FCol,PTTT.BCol),
  376.           Submenu[No].Text[0]);
  377.      ChT := First_Capital(Submenu[No].Text[0],B);
  378.      If B <> 0 then
  379.         FastWrite(pred(X)+B,PTTT.TopY+ord(PTTT.Style>0),
  380.         attr(PTTT.CCol,PTTT.BCol),ChT);
  381.        end;
  382.        GotoXY(X,PTTT.TopY+Ord(PTTT.Style>0));
  383.    end; {Display Main Header}
  384.  
  385.    Procedure Display_Main_Menu;
  386.    {draws boxes, main menu picks and draws border}
  387.    var I : byte;
  388.    begin
  389.        {draw the box}
  390.        Main_Wid := succ(PTTT.Gap) ;           {determine the width of the main menu}
  391.        For I := 1 to Tot_Main do
  392.      Main_Wid := Main_Wid + PTTT.Gap + length(Submenu[I].text[0]);
  393.        If Main_Wid + PTTT.TopX - 1 + ord(PTTT.Style in[1,2]) > 80 then {5.02b}
  394.           PullError(7);
  395.        If PTTT.Style = 0 then
  396.     ClearText(PTTT.TopX,PTTT.TopY,PTTT.TopX + Main_Wid,PTTT.TopY,PTTT.BorCol,PTTT.BCol)
  397.        else
  398.     Fbox(PTTT.TopX,PTTT.TopY,PTTT.TopX + Main_Wid,PTTT.TopY + 2,PTTT.BorCol,PTTT.BCol,PTTT.Style);
  399.        For I := 1 to ToT_Main do
  400.      Display_Main_Picks(I,0);
  401.        Display_Main_Picks(PickM,1);
  402.    end;  {Display_Main_Menu}
  403.  
  404.    Procedure Remove_Sub_Menu;
  405.    var a : integer;
  406.    begin
  407.        Fastwrite(X1,PTTT.TopY+2,attr(PTTT.BorCol,PTTT.BCol),horizchar);
  408.        Fastwrite(X2,PTTT.TopY+2,attr(PTTT.BorCol,PTTT.BCol),horizchar);
  409.        PartRestoreSCreen(PTTT.TopX, succ(PTTT.TopY)+2*ord(PTTT.Style>0), 80, DisplayLines);
  410.        If (PTTT.Style > 0 ) and (X2 >= PTTT.TopX + Main_wid) then
  411.        begin
  412.      A := PTTT.TopX +Main_Wid + 1;
  413.            if A > 80 then  {5.02b}
  414.               A := 80;
  415.      PartRestoreScreen(A, PTTT.TopY + 2, 80, PTTT.TopY + 2);
  416.      Fastwrite(A - 1, PTTT.TopY+2, attr(PTTT.BorCol,PTTT.BCol),BRchar);
  417.        end;
  418.        SubMenu[PickM].LastPick := PickS;
  419.    end;
  420.  
  421.    Procedure Display_Sub_Picks(No : byte; Col : byte);
  422.    { displays sub  menu pick 'No', if Col = 1 then
  423.      PTTT.HFCol and PTTT.HBCol cols are used and arrows, else PTTT.FCol and PTTT.BCol
  424.      colors are used}
  425.    var
  426.      ChT : Char;
  427.      B : Byte;
  428.    begin
  429.        If Col = 1 then
  430.     Fastwrite(X1 + 1, succ(PTTT.TopY)+ord(PTTT.Style>0) + No ,
  431.          attr(PTTT.HFCol,PTTT.HBCol),
  432.          PTTT.LeftChar + Submenu[PickM].Text[No] + PTTT.Rightchar)
  433.        else
  434.        begin
  435.     Fastwrite(X1 + 1, succ(PTTT.TopY)+Ord(PTTT.Style>0) + No ,
  436.          attr(PTTT.FCol,PTTT.BCol),
  437.          ' '+Submenu[PickM].Text[No]+' ');
  438.     ChT := First_Capital(SubMenu[PickM].Text[No],B);
  439.     If B <> 0 then
  440.        FastWrite(X1+1+B,succ(PTTT.TopY)+Ord(PTTT.Style>0) + No ,
  441.             attr(PTTT.CCol,PTTT.BCol),ChT);
  442.        end;
  443.        GotoXY(X1+1,succ(PTTT.TopY)+ord(PTTT.Style>0)+ No);
  444.    end;
  445.  
  446.  
  447.    Procedure Display_Sub_Menu(No :byte);
  448.    var
  449.      BotLine : string;
  450.      I : byte;
  451.    begin
  452.        If (Submenu[pickM].Total = 0) then
  453.      exit
  454.        else
  455.      Down := true;
  456.        X1 := pred(PTTT.TopX);                    {determine box coords of sub menu}
  457.        If No <> 1 then
  458.        begin
  459.      For I := 1 to pred(No) do
  460.          X1 := X1 + PTTT.Gap + length(Submenu[I].text[0]);
  461.      X1 := pred(X1) + PTTT.Gap ;
  462.        end
  463.        else
  464.     X1 := X1 + 2;
  465.        X2 := X1 + Submenu[No].width + 3;
  466.        If X2 > 80 then
  467.        begin
  468.      X1 := 80 - (X2 - X1) ;
  469.      X2 := 80;
  470.        end;
  471.        Y1 := succ(PTTT.TopY) + ord(PTTT.Style>0);
  472.        Y2 := Y1 + 1 + Submenu[No].total;
  473.        Fbox(X1,Y1,X2,Y2,PTTT.BorCol,PTTT.BCol,PTTT.Style);
  474.        Fastwrite(X1,succ(PTTT.TopY)+ord(PTTT.Style>0),attr(PTTT.BorCol,PTTT.BCol),Joinchar);
  475.        If X2 < PTTT.TopX + Main_wid then
  476.     Fastwrite(X2,succ(PTTT.TopY)+ord(PTTT.Style>0),attr(PTTT.BorCol,PTTT.BCol),Joinchar)
  477.        else
  478.        If X2 = PTTT.TopX + Main_wid then
  479.     Fastwrite(X2,succ(PTTT.TopY)+ord(PTTT.Style>0),attr(PTTT.BorCol,PTTT.BCol),Joinleftchar)
  480.        else
  481.        begin
  482.      Fastwrite(X2,PTTT.TopY+2,attr(PTTT.BorCol,PTTT.BCol),TRchar);
  483.      Fastwrite(PTTT.TopX+Main_wid,succ(PTTT.TopY)+ord(PTTT.Style>0),attr(PTTT.BorCol,PTTT.BCol),Joindownchar);
  484.        end;
  485.        For I := 1 to Submenu[PickM].total do
  486.      Display_Sub_Picks(I,2);
  487.        PickS := SubMenu[PickM].LastPick;
  488.        If not (PickS in [1..Submenu[PickM].Total]) then
  489.     PickS := 1;
  490.        Display_Sub_Picks(PickS,1);
  491.    end;  {proc Display_Sub_Menu}
  492.  
  493. begin     {Main Procedure Display_menu}
  494.     Set_Style;
  495.     Load_Menu_Parameters;
  496.     Save_Screen;
  497.     Finished := false;
  498.     If (PickM < 1) then
  499.        PickM := 1;
  500.     Display_Main_Menu;
  501.     For I := 1 to Tot_main do
  502.   Submenu[I].lastPick := 1;
  503.     SubMenu[PickM].LastPick := PickS;
  504.     If PickS <> 0 then
  505.     begin
  506.   Display_Sub_Menu(PickM);
  507.   Down := true;
  508.     end
  509.     else
  510.   Down := false;
  511.     Repeat
  512.     ChM := GetKey;
  513.     {$IFDEF VER40}
  514.     If PM_UserHook <> nil then
  515.        If Down then
  516.      CallFromPM(ChM,PickM,PickS)
  517.        else
  518.      CallFromPM(ChM,PickM,0);
  519.     {$ENDIF}
  520.     {$IFNDEF VER40}
  521.        If Down then
  522.      PTTT.Hook(ChM,PickM,PickS)
  523.        else
  524.      PTTT.Hook(ChM,PickM,0);
  525.     {$ENDIF}
  526.     Case upcase(ChM) of
  527.     'A'..'Z'   : If down then    {check if letter is first letter of menu option}
  528.             begin
  529.            Count := 0;
  530.            Repeat
  531.            Count := succ(count);
  532.            ChT := First_Capital(Submenu[PickM].Text[count],Cap);
  533.            If ChT  = upcase(ChM) then
  534.            begin
  535.                Finished := true;
  536.                Display_Sub_Picks(PickS,0);
  537.                PickS := Count;
  538.                Display_Sub_Picks(PickS,1);
  539.            end;
  540.            Until (Finished) or (count = submenu[PickM].Total);
  541.             end
  542.             else      {down false}
  543.             begin
  544.            Count := 0;
  545.            Repeat
  546.            Count := succ(count);
  547.            ChT := First_Capital(Submenu[Count].Text[0],Cap);
  548.            If ChT = upcase(ChM) then
  549.            begin
  550.                Display_Main_Picks(PickM,0);
  551.                PickM := Count;
  552.                Down := true;
  553.                Display_Main_Picks(PickM,2);
  554.                If not (PickS in [1..Submenu[PickM].Total]) then
  555.                   PickS := 1;
  556.                Display_Sub_Menu(PickM);
  557.            end;
  558.            Until (Down) or (count = Tot_Main);
  559.             end;
  560.     #133,          {Mouse Enter}
  561.     Enter      : If Down or (Submenu[PickM].Total = 0) then
  562.             begin
  563.           Finished := true;
  564.           If Submenu[PickM].Total = 0 then PickS := 0;
  565.             end
  566.             else
  567.             begin
  568.            Down := true;
  569.            Display_Main_Picks(PickM,2);
  570.            Display_Sub_Menu(PickM);
  571.             end;
  572.     #132,        {Mouse Esc}
  573.     Esc       :  If Down then
  574.             begin
  575.            IF not PTTT.AlwaysDown then
  576.            begin
  577.                Down := false;
  578.                Remove_sub_menu;
  579.                Display_Main_menu;
  580.            end
  581.            else
  582.            begin
  583.               If PTTT.AllowEsc then
  584.               begin
  585.              Finished := true;
  586.              PickM := 0;
  587.               end;
  588.            end;
  589.             end
  590.             else
  591.            If PTTT.AllowEsc then
  592.            begin
  593.                Finished := true;
  594.                PickM := 0;
  595.            end;
  596.     #0        :      begin
  597.            end;
  598.     #131      :  If PickM < ToT_main then
  599.             begin
  600.            Display_main_picks(PickM,0);  {clear highlight}
  601.            If Down then
  602.               Remove_Sub_Menu;
  603.            PickM := succ(PickM);
  604.            Display_Main_Picks(PickM,1);
  605.            If down then
  606.               Display_Sub_Menu(PickM);
  607.             end;
  608.     CursRight :  begin
  609.            Display_main_picks(PickM,0);  {clear highlight}
  610.            If Down then
  611.               Remove_Sub_Menu;
  612.            If PickM < ToT_main then
  613.               PickM := PickM + 1
  614.            else
  615.               PickM := 1;
  616.            Display_Main_Picks(PickM,1);
  617.            If down then
  618.                Display_Sub_Menu(PickM);
  619.             end;
  620.     #130      :  If PickM > 1 then    {MouseLeft}
  621.             begin
  622.            Display_main_picks(PickM,0);  {clear highlight}
  623.            If Down then
  624.               Remove_Sub_Menu;
  625.            PickM := pred(PickM);
  626.            Display_Main_Picks(PickM,1);
  627.            If down then
  628.                Display_Sub_Menu(PickM);
  629.             end;
  630.  
  631.     CursLeft  :  begin
  632.            Display_main_picks(PickM,0);  {clear highlight}
  633.            If Down then
  634.               Remove_Sub_Menu;
  635.            If PickM > 1 then
  636.               PickM := pred(PickM)
  637.            else
  638.               PickM := Tot_Main;
  639.            Display_Main_Picks(PickM,1);
  640.            If down then
  641.                Display_Sub_Menu(PickM);
  642.             end;
  643.     #129       : If (Submenu[PickM].Total <> 0) then
  644.             begin
  645.            If Not Down then    {Mouse Down}
  646.            begin
  647.                Down := true;
  648.                Display_Main_Picks(PickM,2);
  649.                Display_Sub_Menu(PickM);
  650.            end
  651.            else
  652.               If PickS < Submenu[PickM].Total then
  653.               begin
  654.              Display_Sub_Picks(PickS,0);
  655.              PickS := succ(PickS);
  656.              Display_Sub_Picks(PickS,1);
  657.               end;
  658.             end;
  659.     CursDown   : If (Submenu[PickM].Total <> 0) then
  660.             begin
  661.            If Not Down then
  662.            begin
  663.                Down := true;
  664.                Display_Main_Picks(PickM,2);
  665.                Display_Sub_Menu(PickM);
  666.            end
  667.            else
  668.            begin
  669.                Display_Sub_Picks(PickS,0);
  670.                If PickS < Submenu[PickM].Total then
  671.              PickS := succ(PickS)
  672.                else
  673.              PickS := 1;
  674.                Display_Sub_Picks(PickS,1);
  675.            end;
  676.             end;
  677.     #128       : If down and (Picks > 1) and (Submenu[PickM].Total <> 0) then  {fix 4.01}
  678.             begin
  679.            Display_Sub_Picks(PickS,0);
  680.            PickS := pred(PickS);
  681.            Display_Sub_Picks(PickS,1);
  682.             end;
  683.     CursUp     : If (Submenu[PickM].Total <> 0) then
  684.             begin
  685.            If down then
  686.            begin
  687.                Display_Sub_Picks(PickS,0);
  688.                If PickS <> 1  then
  689.              PickS := pred(PickS)
  690.                else
  691.              PickS := Submenu[PickM].Total;
  692.                Display_Sub_Picks(PickS,1);
  693.            end;
  694.             end;
  695.     EndKey    :  If (Submenu[PickM].Total <> 0) then
  696.             begin
  697.            If Down then
  698.            begin
  699.                Display_Sub_Picks(PickS,0);
  700.                PickS := Submenu[PickM].Total;
  701.                Display_Sub_Picks(PickS,1);
  702.            end
  703.            else
  704.            begin
  705.                Display_main_picks(PickM,0);  {clear highlight}
  706.                PickM := ToT_Main;
  707.                Display_main_picks(PickM,1);
  708.            end;
  709.             end
  710.             else
  711.             begin
  712.            Display_main_picks(PickM,0);  {clear highlight}
  713.            PickM := ToT_Main;
  714.            Display_main_picks(PickM,1);
  715.            If Down then
  716.            begin
  717.                Display_Main_Picks(PickM,2);
  718.                Display_Sub_Menu(PickM);
  719.            end;
  720.             end;
  721.     HomeKey   :  If (Submenu[PickM].Total <> 0) then
  722.             begin
  723.            If Down then
  724.            begin
  725.                Display_Sub_Picks(PickS,0);
  726.                PickS := 1;
  727.                Display_Sub_Picks(PickS,1);
  728.            end
  729.            else
  730.            begin
  731.                Display_main_picks(PickM,0);  {clear highlight}
  732.                PickM := 1;
  733.                Display_main_picks(PickM,1);
  734.            end;
  735.             end
  736.             else
  737.             begin
  738.            Display_main_picks(PickM,0);  {clear highlight}
  739.            PickM := 1;
  740.            Display_main_picks(PickM,1);
  741.            If Down then
  742.            begin
  743.                Display_Main_Picks(PickM,2);
  744.                Display_Sub_Menu(PickM);
  745.            end;
  746.             end;
  747.     end; {endcase}
  748.      if Submenu[PickM].Total = 0 then PickS := 0;   {5.02a}
  749.  Until Finished;
  750.  If PTTT.RemoveMenu Then
  751.     Restore_Screen;
  752.  Dispose_Screen;
  753.  end;  {end of main procedure Display_Menu}
  754.  
  755. begin
  756.     Horiz_Sensitivity := 4;   {cursors left and right before mouse returns}
  757.     Default_Settings;
  758. end.
  759.